home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Streaming_2113415212008.psc / Clock Killer / ProgramKill.bas < prev    next >
BASIC Source File  |  2003-11-05  |  5KB  |  130 lines
  1. Attribute VB_Name = "KillProgram"
  2. Option Explicit
  3.  
  4. '***************************************************************************************
  5. '   API Declares
  6. '***************************************************************************************
  7. Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
  8. Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
  9. Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  10. Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
  11. Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
  12. Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
  13. Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
  14. '***************************************************************************************
  15. '   Types Used to Retrieve Information From Windows
  16. '***************************************************************************************
  17. Private Type PROCESSENTRY32
  18.     dwSize As Long
  19.     cntUsage As Long
  20.     th32ProcessID As Long           ' This process
  21.     th32DefaultHeapID As Long
  22.     th32ModuleID As Long            ' Associated exe
  23.     cntThreads As Long
  24.     th32ParentProcessID As Long     ' This process's parent process
  25.     pcPriClassBase As Long          ' Base priority of process threads
  26.     dwFlags As Long
  27.     szExeFile As String * 260       ' MAX_PATH
  28. End Type
  29. Private Type OSVERSIONINFO
  30.     dwOSVersionInfoSize As Long
  31.     dwMajorVersion As Long
  32.     dwMinorVersion As Long
  33.     dwBuildNumber As Long
  34.     dwPlatformId As Long
  35.     szCSDVersion As String * 128
  36. End Type
  37. Private Const PROCESS_ALL_ACCESS = 0
  38. Private Const TH32CS_SNAPPROCESS As Long = 2&
  39. 'Used to determine what OS Version
  40. Private Const WINNT As Integer = 2
  41. Private Const WIN98 As Integer = 1
  42. 'Used to return error code
  43. Public KillAppReturn As Boolean
  44. Public Function getVersion() As Integer
  45.   Dim udtOSInfo As OSVERSIONINFO
  46.   Dim intRetVal As Integer
  47.          
  48.   'Initialize the type's buffer sizes
  49.     With udtOSInfo
  50.         .dwOSVersionInfoSize = 148
  51.         .szCSDVersion = Space$(128)
  52.     End With
  53.     
  54.   'Make an API Call to Retrieve the OSVersion info
  55.     intRetVal = GetVersionExA(udtOSInfo)
  56.   
  57.   'Set the return value
  58.     getVersion = udtOSInfo.dwPlatformId
  59. End Function
  60. Public Function Killapp(myName As String)
  61. Select Case getVersion()
  62. Case WIN98 'Windows 95/98
  63. Killapp9X (myName)
  64. Case WINNT 'Windows NT
  65. KillappNT (myName)
  66. End Select
  67. End Function
  68. Private Function KillappNT(myName As String)
  69.     Dim uProcess As PROCESSENTRY32
  70.     Dim rProcessFound As Long
  71.     Dim hSnapshot As Long
  72.     Dim szExename As String
  73.     Dim exitCode As Long
  74.     Dim myProcess As Long
  75.     Dim AppKill As Boolean
  76.     Dim appCount As Integer
  77.     Dim I As Integer
  78.     On Local Error GoTo Finish
  79.     appCount = 0
  80.     uProcess.dwSize = Len(uProcess)
  81.     hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
  82.     rProcessFound = ProcessFirst(hSnapshot, uProcess)
  83.     Do While rProcessFound
  84.         I = InStr(1, uProcess.szExeFile, Chr(0))
  85.         szExename = LCase$(Left$(uProcess.szExeFile, I - 1))
  86.         If Right$(szExename, Len(myName)) = LCase$(myName) Then
  87.             KillAppReturn = True
  88.             appCount = appCount + 1
  89.             myProcess = OpenProcess(1&, -1&, uProcess.th32ProcessID)
  90.             AppKill = TerminateProcess(myProcess, 0&)
  91.             Call CloseHandle(myProcess)
  92.         End If
  93.         rProcessFound = ProcessNext(hSnapshot, uProcess)
  94.     Loop
  95.     Call CloseHandle(hSnapshot)
  96. Finish:
  97. KillAppReturn = False
  98. End Function
  99. Private Function Killapp9X(myName As String)
  100.     Dim uProcess As PROCESSENTRY32
  101.     Dim rProcessFound As Long
  102.     Dim hSnapshot As Long
  103.     Dim szExename As String
  104.     Dim exitCode As Long
  105.     Dim myProcess As Long
  106.     Dim AppKill As Boolean
  107.     Dim appCount As Integer
  108.     Dim I As Integer
  109.     On Local Error GoTo Finish
  110.     appCount = 0
  111.     uProcess.dwSize = Len(uProcess)
  112.     hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
  113.     rProcessFound = ProcessFirst(hSnapshot, uProcess)
  114.     Do While rProcessFound
  115.         I = InStr(1, uProcess.szExeFile, Chr(0))
  116.         szExename = LCase$(Left$(uProcess.szExeFile, I - 1))
  117.         If Right$(szExename, Len(myName)) = LCase$(myName) Then
  118.             KillAppReturn = True
  119.             appCount = appCount + 1
  120.             myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
  121.             AppKill = TerminateProcess(myProcess, exitCode)
  122.             Call CloseHandle(myProcess)
  123.         End If
  124.         rProcessFound = ProcessNext(hSnapshot, uProcess)
  125.     Loop
  126.     Call CloseHandle(hSnapshot)
  127. Finish:
  128. KillAppReturn = False
  129. End Function
  130.